home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / EMPRATE.PRG < prev    next >
Encoding:
Text File  |  1990-06-16  |  7.7 KB  |  290 lines
  1. ********************************************************************************
  2. * Program......: EMPRATE
  3. * Author.......: Bruce Troutman
  4. * Date.........: 12-04-88
  5. * Notice.......: (c) Interco International, Ltd.
  6. * dBASE Ver....: 
  7. * Generated by.: APGEN version 1.0
  8. * Description..: Employee Rate File Manager
  9.  
  10. * Notes........:
  11. ********************************************************************************
  12.  
  13. SET CONSOLE OFF
  14. IF TYPE("gn_apgen") = "U"  && We were not called from another APGEN program
  15.    CLEAR ALL
  16.    CLEAR WINDOW
  17.    CLOSE ALL
  18.    gn_apgen = 1
  19. ELSE
  20.    gn_apgen = gn_apgen + 1 
  21.    PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
  22.            gc_escape, gc_instruc, gc_safety, gc_status, gc_score, gc_talk
  23. ENDIF
  24.  
  25. *-- Window for pause message box (ON ERROR)
  26. DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE
  27. ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
  28. ON KEY LABEL F1 DO quickhlp
  29.  
  30. *-- Store initial SETs to variables
  31. gc_bell   =SET("BELL")
  32. gc_carry  =SET("CARRY")
  33. gc_clock  =SET("CLOCK")
  34. gc_century=SET("CENTURY")
  35. gc_confirm=SET("CONFIRM")
  36. gc_deli   =SET("DELIMITERS")
  37. gc_escape =SET("ESCAPE")
  38. gc_instruc=SET("INSTRUCT")
  39. gc_safety =SET("SAFETY")
  40. gc_status =SET("STATUS")
  41. gc_score  =SET("SCOREBOARD")
  42. gc_talk   =SET("TALK")
  43.  
  44. SET CLOCK OFF
  45. SET COLOR TO
  46. CLEAR
  47. SET CONSOLE ON
  48.  
  49. *-- Sets for application
  50. SET BELL ON
  51. SET CARRY OFF
  52. SET CENTURY OFF
  53. SET CONFIRM OFF
  54. SET DELIMITERS TO ""
  55. SET DELIMITER OFF
  56. SET ESCAPE ON
  57. ***SET INSTRUCT OFF ** remove for RunTime
  58. SET SAFETY ON
  59. SET SCOREBOARD OFF
  60. SET STATUS OFF
  61. SET TALK OFF
  62.  
  63. *-- Set global variables
  64. gn_barv  = 0                 && Initialize bar value variable
  65. gn_error = 0                 && Variable to store error() number
  66. gn_send  = 0                 && Return variable from popup
  67. gc_brdr  = "2"               && Border style for menu box - See Procedure
  68. lc_heading = "Employee Rate file Manager" && Menu heading string
  69. ll_color = ISCOLOR()
  70.  
  71. CLEAR
  72. SET ESCAPE ON
  73. SET STATUS ON
  74. *-- Set colors
  75. IF ll_color
  76.    SET COLOR OF NORMAL TO w+/b
  77.    SET COLOR OF MESSAGES TO w+/b
  78.    SET COLOR OF TITLES TO w+/b
  79.    SET COLOR OF HIGHLIGHT TO b/w
  80.    SET COLOR OF BOX TO b/w
  81.    SET COLOR OF INFORMATION TO b/w
  82.    SET COLOR OF FIELDS TO b/w
  83. ENDIF
  84.  
  85. USE EMPRATE INDEX EMPRATE
  86. SET ORDER TO EMPID
  87.  
  88. *-- Define the main popup menu for Quickapp
  89. SET BORDER TO DOUBLE
  90. DEFINE POPUP quick FROM 7,27
  91. DEFINE BAR 1 OF quick PROMPT " Add Information" MESSAGE "Add records to database EMPRATE"
  92. DEFINE BAR 2 OF quick PROMPT " Change Information" MESSAGE "Edit records in database EMPRATE"
  93. DEFINE BAR 3 OF quick PROMPT " Browse Information" MESSAGE "Browse database EMPRATE"
  94. DEFINE BAR 4 OF quick PROMPT " Discard Marked Records " MESSAGE "Purge deleted records in database EMPRATE"
  95. DEFINE BAR 5 OF quick PROMPT " Reindex Database" MESSAGE "Reindex database EMPRATE"
  96. DEFINE BAR 6 OF quick PROMPT " Exit From Emprate" MESSAGE "Exit program to dBASE"
  97. ON SELECTION POPUP quick DO Action WITH BAR()
  98.  
  99.  
  100. *-- Window to cover work surface during edit, append, etc.
  101. DEFINE WINDOW work FROM 0,0 TO 21,79 NONE
  102.  
  103. *-- Window for area below menu heading & for running reports/labels in
  104. DEFINE WINDOW desktop FROM 4,0 TO 21,79 NONE
  105.  
  106. DEFINE WINDOW printemp FROM 10,25 TO 15,56
  107.  
  108. *-- Display heading centered on the screen.
  109. DO menubox WITH lc_heading
  110.  
  111. *-- Show the menu so we don't get a flash if the user hits arrow keys or ESC
  112. SHOW POPUP quick
  113. SAVE SCREEN TO quick
  114. *-- Display Quickapp menu centered on the screen.
  115. DO WHILE gn_barv <> 6 && Prevent user from exiting with arrow keys or ESC
  116.   ACTIVATE POPUP quick
  117. ENDDO
  118.  
  119. * Restore SET environment the best we can
  120. SET BELL &gc_bell.
  121. SET CARRY &gc_carry.
  122. SET CLOCK TO
  123. SET CLOCK &gc_clock.
  124. SET CENTURY &gc_century.
  125. SET CONFIRM &gc_confirm.
  126. SET DELIMITERS &gc_deli.
  127. SET ESCAPE &gc_escape.
  128. *** SET INSTRUCT &gc_instruc. ** Remove for RunTime
  129. SET STATUS &gc_status.
  130. SET SAFETY &gc_safety.
  131. SET SCORE  &gc_score.
  132. SET TALK   &gc_talk.
  133. SET FORMAT TO
  134.  
  135. IF gn_apgen = 1 && We were not called from another APGEN program
  136.    CLEAR WINDOW
  137.    CLEAR POPUP
  138.    CLEAR ALL
  139.    CLOSE ALL
  140. ELSE
  141.    RELEASE WINDOWS work, desktop 
  142.    RELEASE SCREEN quick
  143.    RELEASE POPUP quick
  144.    gn_apgen = gn_apgen - 1 
  145. ENDIF
  146. ON ERROR
  147. ON KEY LABEL F1
  148. RETURN
  149. * EOP: EMPRATE.PRG
  150.  
  151. ********************************************************************************
  152. * Procedures...: EMPRATE.Prc
  153. * Author.......: Bruce Troutman
  154. * Date.........: 12-04-88
  155. * Notice.......: (c) Interco International, Ltd.
  156. * dBASE Ver....: 
  157. * Generated by.: APGEN version 1.0
  158. * Description..: Employee Rate File Manager
  159.  
  160. * Notes........:
  161. ********************************************************************************
  162.  
  163. *-- Here is a sample procedure file to show the power of procdures.
  164. *-- This example - Menubox displays a menu heading box with a centered heading.
  165. PROCEDURE MenuBox
  166. PARAMETER lc_m_name
  167. *-- Parameter lc_m_name - is the title variable for the menu
  168. SET CLOCK OFF
  169. @ 1,0 FILL TO 2,79 COLOR n/n
  170. DO CASE
  171. CASE gc_brdr = "0"
  172.    @ 1,0 CLEAR TO 3,79
  173. CASE gc_brdr = "1"
  174.    @ 1,0 TO 3,79
  175. CASE gc_brdr = "2"
  176.    lc_color = IIF(ISCOLOR(),"b/w", "W+/N")
  177.    @ 1,0 TO 3,79 DOUBLE COLOR &lc_color.
  178. ENDCASE
  179. SET CLOCK TO 2,68
  180. @ 2,1 SAY SUBSTR(CDOW(DATE()),1,3)+'. '+DTOC(DATE())+' '
  181. @ 2,41 - (LEN(lc_m_name)/2) SAY lc_m_name
  182. lc_color = IIF(ISCOLOR(),"w+/b", "W+/N")
  183. @ 2,1 FILL TO 2,78 COLOR &lc_color.
  184. RETURN
  185.  
  186.  
  187. PROCEDURE get_sele
  188. *-- Get the user selection & store BAR into variable
  189. gn_send = BAR()  && Variable for print testing
  190. DEACTIVATE POPUP
  191. RETURN
  192.  
  193. PROCEDURE Action
  194. PARAMETERS bar
  195. *-- Get the user selection & store BAR into variable
  196. gn_barv = bar
  197. SET MESSAGE TO
  198. IF LTRIM( STR( gn_barv)) $ "123"
  199.    *-- Set format file EMPRATE for edit/append/browse
  200.    SET FORMAT TO EMPRATE
  201. ENDIF
  202. DO CASE
  203.    CASE gn_barv = 1
  204.       *-- Add information
  205.       SET MESSAGE TO 'Appending records to file EMPRATE'
  206.       APPEND
  207.    CASE gn_barv = 2
  208.       *-- Change information
  209.       SET MESSAGE TO 'Editing file EMPRATE'
  210.       EDIT
  211.    CASE gn_barv = 3
  212.       *-- Browse information
  213.       SET MESSAGE TO 'Browsing file EMPRATE'
  214.       BROWSE FORMAT 
  215.    CASE gn_barv = 4
  216.       *-- Remove information (Pack file emprate)
  217.       ACTIVATE WINDOW desktop
  218.       @ 2,0 SAY "Packing database EMPRATE to REMOVE records marked for deletion..."
  219.       @ 3,0
  220.       SET TALK ON
  221.       PACK
  222.       GO TOP
  223.       ?
  224.       WAIT
  225.       SET TALK OFF
  226.       DEACTIVATE WINDOW desktop
  227.    CASE gn_barv = 5
  228.       *-- Reindex emprate
  229.       ACTIVATE WINDOW desktop
  230.       @ 3,0 SAY "Reindexing database EMPRATE..."
  231.       @ 4,0
  232.       SET TALK ON
  233.       REINDEX
  234.       GO TOP
  235.       ?
  236.       WAIT
  237.       SET TALK OFF
  238.       DEACTIVATE WINDOW desktop
  239.    CASE gn_barv = 6
  240.       DEACTIVATE POPUP
  241. ENDCASE
  242. SET MESSAGE TO
  243. IF gc_status = "OFF"
  244.    SET STATUS ON
  245. ENDIF
  246. SET FORMAT TO
  247. RESTORE SCREEN FROM quick
  248. RETURN
  249.  
  250. PROCEDURE Pause
  251. PARAMETER lc_msg
  252. *-- Parameters : lc_msg = message line
  253. IF TYPE("lc_message")="U"
  254.    gn_error=ERROR()
  255. ENDIF
  256. lc_msg = lc_msg
  257. lc_option='0'
  258. ACTIVATE WINDOW Pause
  259. IF gn_error > 0
  260.    IF TYPE("lc_message")="U"
  261.       @ 0,1 SAY [An error has occurred !! - Error message: ]+MESSAGE()
  262.    ELSE
  263.       @ 0,1 SAY [Error # ]+lc_message
  264.    ENDIF
  265. ENDIF
  266. @ 1,1 SAY lc_msg
  267. WAIT " Press any key to continue..."
  268. DEACTIVATE WINDOW Pause
  269. RETURN
  270.  
  271.  
  272. PROCEDURE quickhlp
  273. *--  If you want to include help for a quickapp uncomment the lines below and
  274. *--  put your help @ say's into the case statements
  275. *ACTIVATE WINDOW desktop
  276. *CLEAR
  277. DO CASE
  278.   CASE BAR() = 1
  279.   CASE BAR() = 2
  280.   CASE BAR() = 3
  281.   CASE BAR() = 4
  282.   CASE BAR() = 5
  283.   CASE BAR() = 6
  284. ENDCASE
  285. *WAIT
  286. *DEACTIVATE WINDOW desktop
  287. RETURN
  288.  
  289. * EOF: EMPRATE.PRG
  290.